VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsOthello"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function PolyPolyline Lib "gdi32.dll" (ByVal hdc As Long, ByRef lppt As POINTAPI, ByRef lpdwPolyPoints As Long, ByVal cCount As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Const NULL_BRUSH As Long = 5
Private Const WHITE_BRUSH As Long = 0
Private Const BLACK_BRUSH As Long = 4

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Implements IGameState

Private Type typeOthelloState
 nPlayerJustMoved As Long
 b(7, 7) As Byte
End Type

Private m_t As typeOthelloState
Private m_nMoves As Long

Friend Sub CloneFrom(ByRef t As typeOthelloState)
m_t = t
End Sub

Private Sub IGameState_ClearUserMoves()
'///ad-hoc: put some initialization code here
If m_t.nPlayerJustMoved = 0 Then
 m_t.b(3, 3) = 2
 m_t.b(3, 4) = 1
 m_t.b(4, 3) = 1
 m_t.b(4, 4) = 2
 m_t.nPlayerJustMoved = 2
End If
'///
m_nMoves = -1
End Sub

Private Function IGameState_Clone() As IGameState
Dim obj As New clsOthello
obj.CloneFrom m_t
Set IGameState_Clone = obj
End Function

Private Function IGameState_DoMove(ByVal lpData As Long, ByVal nSize As Long) As Boolean
Dim i As Long, j As Long
Dim m As Long
'///
If lpData = 0 Or nSize < 1 Then Exit Function
CopyMemory i, ByVal lpData, 1
'///
If i And &H80& Then 'skip
 '///check if there are really no avaliable moves
 For j = 0 To 7
  For i = 0 To 7
   If m_t.b(i, j) = 0 Then
    m = m + 1
    If CheckSandwich(i, j, m_t.nPlayerJustMoved) Then
     m = -1
     Exit For
    End If
   End If
  Next i
  If m < 0 Then Exit For
 Next j
 If m <= 0 Then Exit Function
 '///over
 m_t.nPlayerJustMoved = (m_t.nPlayerJustMoved And 1&) + 1
Else
 '///check move
 j = (i \ &H10&) And &H7&
 i = i And &H7&
 If m_t.b(i, j) <> 0 Then Exit Function
 If Not DoSandwich(i, j, m_t.nPlayerJustMoved) Then Exit Function
 '///over
 m_t.nPlayerJustMoved = (m_t.nPlayerJustMoved And 1&) + 1
End If
'///
IGameState_DoMove = True
End Function

Private Function IGameState_Draw(ByVal bm As cDIBSection, ByVal nWidth As Long, ByVal nHeight As Long) As Boolean
Dim w As Long
Dim hbr(2) As Long, hpn As Long
Dim r As RECT
Dim i As Long, j As Long
Dim p(35) As POINTAPI, m2(17) As Long
'///
hbr(0) = CreateSolidBrush(GetSysColor(vbButtonFace And &HFF&))
r.Right = nWidth
r.Bottom = nHeight
FillRect bm.hdc, r, hbr(0)
DeleteObject hbr(0)
'///
If nWidth > nHeight Then nWidth = nHeight
w = nWidth \ 8
'///check if there are no avaliable moves
hpn = 0
For j = 0 To 7
 For i = 0 To 7
  If m_t.b(i, j) = 0 Then
   hpn = hpn + 1
   If CheckSandwich(i, j, m_t.nPlayerJustMoved) Then
    hpn = -1
    Exit For
   End If
  End If
 Next i
 If hpn < 0 Then Exit For
Next j
If hpn > 0 Then
 hbr(0) = CreateSolidBrush(&H8080FF)
 r.Right = w * 8
 r.Bottom = w * 8
 FillRect bm.hdc, r, hbr(0)
 DeleteObject hbr(0)
End If
'///
hbr(0) = SelectObject(bm.hdc, GetStockObject(NULL_BRUSH))
hbr(1) = GetStockObject(BLACK_BRUSH)
hbr(2) = GetStockObject(WHITE_BRUSH)
hpn = SelectObject(bm.hdc, CreatePen(0, 2, vbBlack))
'///
For i = 0 To 8
 p(i * 2).x = i * w
 p(i * 2 + 1).x = i * w
 p(i * 2 + 1).y = 8 * w
 p(i * 2 + 18).y = i * w
 p(i * 2 + 19).x = 8 * w
 p(i * 2 + 19).y = i * w
 m2(i) = 2
 m2(i + 9) = 2
Next i
PolyPolyline bm.hdc, p(0), m2(0), 18
'///
For j = 0 To 7
 For i = 0 To 7
  r.Left = m_t.b(i, j)
  If r.Left > 0 Then
   SelectObject bm.hdc, hbr(((r.Left - 1) And 1&) + 1)
   Ellipse bm.hdc, i * w + 4, j * w + 4, (i + 1) * w - 4, (j + 1) * w - 4
  End If
 Next i
Next j
'///
SelectObject bm.hdc, hbr(0)
DeleteObject SelectObject(bm.hdc, hpn)
End Function

'internal function, check if current player can sandwich
'i,j should be in 0 to 7, nPlayerJustMoved should be 0(any) or 1 or 2
Friend Function CheckSandwich(ByVal i As Long, ByVal j As Long, ByVal nPlayerJustMoved As Long) As Boolean
Dim ii As Long, jj As Long
Dim k As Long, l As Long
'///
If m_t.b(i, j) Then Exit Function
'///
If i > 1 Then
 '///check left
 k = m_t.b(i - 1, j)
 If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
  ii = i - 2
  Do
   l = m_t.b(ii, j)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - k Then
    CheckSandwich = True
    Exit Function
   End If
   ii = ii - 1
  Loop While ii >= 0
 End If
 '///check top-left
 If j > 1 Then
  k = m_t.b(i - 1, j - 1)
  If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
   ii = i - 2
   jj = j - 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - k Then
     CheckSandwich = True
     Exit Function
    End If
    ii = ii - 1
    jj = jj - 1
   Loop While ii >= 0 And jj >= 0
  End If
 End If
 '///check bottom-left
 If j < 6 Then
  k = m_t.b(i - 1, j + 1)
  If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
   ii = i - 2
   jj = j + 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - k Then
     CheckSandwich = True
     Exit Function
    End If
    ii = ii - 1
    jj = jj + 1
   Loop While ii >= 0 And jj <= 7
  End If
 End If
End If
'///
If j > 1 Then
 '///check top
 k = m_t.b(i, j - 1)
 If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
  jj = j - 2
  Do
   l = m_t.b(i, jj)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - k Then
    CheckSandwich = True
    Exit Function
   End If
   jj = jj - 1
  Loop While jj >= 0
 End If
End If
'///
If j < 6 Then
 '///check top
 k = m_t.b(i, j + 1)
 If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
  jj = j + 2
  Do
   l = m_t.b(i, jj)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - k Then
    CheckSandwich = True
    Exit Function
   End If
   jj = jj + 1
  Loop While jj <= 7
 End If
End If
'///
If i < 6 Then
 '///check right
 k = m_t.b(i + 1, j)
 If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
  ii = i + 2
  Do
   l = m_t.b(ii, j)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - k Then
    CheckSandwich = True
    Exit Function
   End If
   ii = ii + 1
  Loop While ii <= 7
 End If
 '///check top-right
 If j > 1 Then
  k = m_t.b(i + 1, j - 1)
  If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
   ii = i + 2
   jj = j - 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - k Then
     CheckSandwich = True
     Exit Function
    End If
    ii = ii + 1
    jj = jj - 1
   Loop While ii <= 7 And jj >= 0
  End If
 End If
 '///check bottom-right
 If j < 6 Then
  k = m_t.b(i + 1, j + 1)
  If k <> 0 And (k = nPlayerJustMoved Or nPlayerJustMoved = 0) Then
   ii = i + 2
   jj = j + 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - k Then
     CheckSandwich = True
     Exit Function
    End If
    ii = ii + 1
    jj = jj + 1
   Loop While ii <= 7 And jj <= 7
  End If
 End If
End If
'///over
End Function

'internal function
Friend Function DoSandwich(ByVal i As Long, ByVal j As Long, ByVal nPlayerJustMoved As Long) As Boolean
Dim ii As Long, jj As Long
Dim k As Long, l As Long, m As Long
Dim ret As Boolean
'///
If m_t.b(i, j) Then Exit Function
'///
If i > 1 Then
 '///check left
 If m_t.b(i - 1, j) = nPlayerJustMoved Then
  ii = i - 2
  Do
   l = m_t.b(ii, j)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - nPlayerJustMoved Then
    ret = True
    For k = ii To i
     m_t.b(k, j) = l
    Next k
    Exit Do
   End If
   ii = ii - 1
  Loop While ii >= 0
 End If
 '///check top-left
 If j > 1 Then
  If m_t.b(i - 1, j - 1) = nPlayerJustMoved Then
   ii = i - 2
   jj = j - 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - nPlayerJustMoved Then
     ret = True
     For k = ii To i
      m_t.b(k, jj + k - ii) = l
     Next k
     Exit Do
    End If
    ii = ii - 1
    jj = jj - 1
   Loop While ii >= 0 And jj >= 0
  End If
 End If
 '///check bottom-left
 If j < 6 Then
  If m_t.b(i - 1, j + 1) = nPlayerJustMoved Then
   ii = i - 2
   jj = j + 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - nPlayerJustMoved Then
     ret = True
     For k = ii To i
      m_t.b(k, jj - k + ii) = l
     Next k
     Exit Do
    End If
    ii = ii - 1
    jj = jj + 1
   Loop While ii >= 0 And jj <= 7
  End If
 End If
End If
'///
If j > 1 Then
 '///check top
 If m_t.b(i, j - 1) = nPlayerJustMoved Then
  jj = j - 2
  Do
   l = m_t.b(i, jj)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - nPlayerJustMoved Then
    ret = True
    For k = jj To j
     m_t.b(i, k) = l
    Next k
    Exit Do
   End If
   jj = jj - 1
  Loop While jj >= 0
 End If
End If
'///
If j < 6 Then
 '///check top
 If m_t.b(i, j + 1) = nPlayerJustMoved Then
  jj = j + 2
  Do
   l = m_t.b(i, jj)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - nPlayerJustMoved Then
    ret = True
    For k = j To jj
     m_t.b(i, k) = l
    Next k
    Exit Do
   End If
   jj = jj + 1
  Loop While jj <= 7
 End If
End If
'///
If i < 6 Then
 '///check right
 If m_t.b(i + 1, j) = nPlayerJustMoved Then
  ii = i + 2
  Do
   l = m_t.b(ii, j)
   If l = 0 Then
    Exit Do
   ElseIf l = 3 - nPlayerJustMoved Then
    ret = True
    For k = i To ii
     m_t.b(k, j) = l
    Next k
    Exit Do
   End If
   ii = ii + 1
  Loop While ii <= 7
 End If
 '///check top-right
 If j > 1 Then
  If m_t.b(i + 1, j - 1) = nPlayerJustMoved Then
   ii = i + 2
   jj = j - 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - nPlayerJustMoved Then
     ret = True
     For k = i To ii
      m_t.b(k, jj - k + ii) = l
     Next k
     Exit Do
    End If
    ii = ii + 1
    jj = jj - 1
   Loop While ii <= 7 And jj >= 0
  End If
 End If
 '///check bottom-right
 If j < 6 Then
  If m_t.b(i + 1, j + 1) = nPlayerJustMoved Then
   ii = i + 2
   jj = j + 2
   Do
    l = m_t.b(ii, jj)
    If l = 0 Then
     Exit Do
    ElseIf l = 3 - nPlayerJustMoved Then
     ret = True
     For k = i To ii
      m_t.b(k, jj + k - ii) = l
     Next k
     Exit Do
    End If
    ii = ii + 1
    jj = jj + 1
   Loop While ii <= 7 And jj <= 7
  End If
 End If
End If
'///over
DoSandwich = ret
End Function

Private Function IGameState_FilterByRandomFactor(ByVal lpData As Long, ByVal nSize As Long) As Boolean
IGameState_FilterByRandomFactor = True
End Function

Private Function IGameState_GetMoves(bData() As Byte, nSize As Long, ByVal bRespectRandomFactor As Boolean) As Long
Dim i As Long, j As Long, m As Long, mm As Long
'///
ReDim bData(63)
'///
For j = 0 To 7
 For i = 0 To 7
  If m_t.b(i, j) = 0 Then
   mm = mm + 1
   If CheckSandwich(i, j, m_t.nPlayerJustMoved) Then
    bData(m) = j * 16& + i
    m = m + 1
   End If
  End If
 Next i
Next j
'///
If mm > 0 And m = 0 Then
 bData(0) = &HFF&
 m = 1
End If
'///
nSize = 1
IGameState_GetMoves = m
End Function

Private Function IGameState_GetRandomMoves(bData() As Byte, nSize As Long, ByVal bReversed As Boolean) As Boolean
Dim i As Long, j As Long, m As Long, mm As Long
Dim b(63) As Byte
Dim b2(3) As Byte, m2 As Long
'///
ReDim bData(0)
nSize = 1
'///
For j = 0 To 7
 For i = 0 To 7
  If m_t.b(i, j) = 0 Then
   mm = mm + 1
   If CheckSandwich(i, j, m_t.nPlayerJustMoved) Then
    b(m) = j * 16& + i
    m = m + 1
    'prefer winning moves (??)
    If i = 0 Or i = 7 Then
     If j = 0 Or j = 7 Then
      b2(m2) = j * 16& + i
      m2 = m2 + 1
     End If
    End If
   End If
  End If
 Next i
Next j
'///
If m > 0 Then
 'prefer winning moves (??)
 If m2 > 0 And Not bReversed Then
  If Rnd < 0.5! Then
   bData(0) = b2(Int(m2 * Rnd))
   IGameState_GetRandomMoves = True
   Exit Function
  End If
 End If
 bData(0) = b(Int(m * Rnd))
 IGameState_GetRandomMoves = True
ElseIf mm > 0 Then
 bData(0) = &HFF&
 IGameState_GetRandomMoves = True
End If
'///
End Function

Private Function IGameState_GetResult(ByVal nPlayerJustMoved As Long) As Long
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim b As Boolean
'///check if there are no avaliable moves for both two players
For j = 0 To 7
 For i = 0 To 7
  If CheckSandwich(i, j, 0) Then
   b = True
   Exit For
  End If
 Next i
 If b Then Exit For
Next j
'///
If b Then 'still can move
 IGameState_GetResult = 3
Else 'can't move any more
 For j = 0 To 7
  For i = 0 To 7
   Select Case m_t.b(i, j) Xor nPlayerJustMoved
   Case 0
    k = k + 1
   Case 3
    l = l + 1
   End Select
  Next i
 Next j
 If k > l Then IGameState_GetResult = 1 _
 Else If k < l Then IGameState_GetResult = 0 _
 Else IGameState_GetResult = 2
End If
End Function

Private Function IGameState_GetUserMoves(bData() As Byte, nSize As Long) As Boolean
If m_nMoves < 0 Then Exit Function
ReDim bData(0)
bData(0) = m_nMoves
nSize = 1
IGameState_GetUserMoves = True
End Function

Private Function IGameState_OnMouseDown(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
Dim i As Long, j As Long
Dim m As Long
'///
If nWidth > nHeight Then nWidth = nHeight
nWidth = nWidth \ 8
If nWidth <= 0 Then Exit Function
'///
If x < 0 Or y < 0 Then Exit Function
x = x \ nWidth
y = y \ nWidth
If x >= 8 Or y >= 8 Then Exit Function
'///
If Button = vbRightButton Then
 m_nMoves = &HFF&
Else
 m_nMoves = y * 16& + x
End If
IGameState_OnMouseDown = 2
End Function

Private Function IGameState_OnMouseMove(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
'do nothing
End Function

Private Function IGameState_OnMouseUp(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
'do nothing
End Function

Private Property Get IGameState_PlayerJustMoved() As Long
IGameState_PlayerJustMoved = m_t.nPlayerJustMoved
End Property
